home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr02
/
bulkst10.zip
/
MAILSORT.PRG
< prev
next >
Wrap
Text File
|
1993-06-15
|
18KB
|
757 lines
*
* Bulk Mail Sorting Program
* Version 1.0
* Written by Gerri Hesselberg
* June, 1993
*
* This program was written by a frustrated office manager in an attempt
* to save labor manually sorting labels.
*
* The program is stand alone and can be run as is. Use the setup to tell
* the system about the file name and long field name (for label instructions).
* Make sure there is a character field called ZIP_CODE, and make sure
* there is NO field called ORDER. Then run setup the first time you
* use the program.
*
* Files used: MAILSORT.PRG
* ZIPSUM.DBF
* MAILSYST.DBF
* MAILZIP.NDX (Foxpro may change this to .IDX)
*
*
* Rules: Please feel free to use this code as you wish, but be sure to
* send $20 to the address shown in the setup option.
*
* Please send any feedback, comments, or questions either to the mailing
* address shown in the setup option or to Tuvia Vinitsky, CIS 70034,510
*
* Happy sorting!
*
CLEAR ALL
SET TALK OFF
SET BELL OFF
SET HEADING OFF
SET DELETED ON
SET SAFETY OFF
mchoice = 1
do while .t.
clear
@ 5,5 say '[1] Run mail sort program'
@ 7,5 say '[2] Change postal rates'
@ 9,5 say '[3] Instructions and setup'
@ 11,5 say '[4] Exit'
@ 13,10 say 'Enter choice: ' get mchoice pict '9' range 1,4
read
use mailsyst
1
mfive = five
mbasic = basic
mfield = field
mlist = list
do case
case mchoice = 4
CLEAR ALL
SET TALK on
SET BELL on
SET HEADING on
SET DELETED off
SET SAFETY on
return
case mchoice = 1
exit
case mchoice = 2
clear
@ 5,5 say 'Enter 3/5 presort rate: ' get mfive pict '9.999'
@ 7,5 say 'Enter basic rate: ' get mbasic pict '9.999'
read
replace five with mfive
replace basic with mbasic
clear
wait 'Hit "x" to exit, any other key to run mailsort' to mx
if upper(mx) = 'X'
CLEAR ALL
SET TALK ON
SET BELL on
SET HEADING on
SET DELETED off
SET SAFETY on
return
endif
case mchoice = 3
clear
text
Mailsort will sort your mailing list by five-digit ZIP Code in proper order
for third class (bulk) mailing.
This program is current with the postal regulations as of June 14, 1993.
Please send $20 to:
Vinitsky Consulting
c/o Y.M.T.
2728 West Pratt
Chicago, Illinois 60645
to be notified of upgrades.
endtext
wait 'Hit any key for next screen.'
clear
text
Mailsort needs to be setup. When you run the setup, you will be asked
for the following: 1) the name of your mailing list, 2) the name of a
long field in your record, 3) the current 3/5 presort rate, and
4) the current basic rate.
When the postage rates change, it is not necessary to run the entire setup.
A menu option allows you to change just the postage.
IMPORTANT: The zip code field in the database must be called ZIP_CODE.
The sort routine will add a field called ORDER to your database, make
sure there is not a field by that name already. Also, no zip code
fields can be blank. (This limitation will be addressed in future
versions.)
endtext
wait 'Hit "X" to exit, any other key to run set-up.' to mx
if upper(mx) <> 'X'
clear
@ 5,5 say 'Please enter the following information:'
@ 7,5 say 'Mailing list name: ' get mlist
@ 8,5 say 'EXAMPLE: FILENAME or FILENAME.EXT if on this directory,'
@ 9,5 say '\DIRECTORY\FILENAME or \DIRECTORY\FIELNAME.EXT if on a'
@ 10,5 say 'different directory.'
@ 12,5 say 'Long field in record: ' get mfield
@ 14,5 say 'Enter 3/5 presort rate: ' get mfive pict '9.999'
@ 16,5 say 'Enter basic rate: ' get mbasic pict '9.999'
read
replace five with mfive
replace basic with mbasic
replace list with mlist
replace field with mfield
clear
use &mlist
copy to mailext structure extended
use mailext
appe blank
replace field_name with 'order'
replace field_type with 'N'
replace field_len with 3
replace field_dec with 0
create mailing from mailext
wait
mchoice = 1
loop
endif
endcase
enddo
clear
mmax = 125
@ 5,5 say 'Enter maximum number of pieces per sack: ' get mmax pict '9999' range 125,
@ 6,5 say 'minimum is 125.'
read
clear
@ 10,10 say 'Please be patient . . .'
y = 1
z = 5
nosack = 0
acount = 0
bcount = 0
sele 1
use zipsum
zap
sele 2
use mailing index mailzip
zap
appe from &mlist
rein
go top
set device to print
@ z,7 say 'MAIL SUMMARY REPORT'
Z = Z + 2
@ Z,7 say 'SACK'
@ Z,17 SAY 'STATE'
@ Z,27 SAY 'COUNT'
@ Z,37 SAY '# OF SACKS'
Z = Z + 2
if z > 55
eject
z = 5
@ Z,5 say 'ZIP CODE'
@ Z,17 SAY 'STATE'
@ Z,27 SAY 'COUNT'
@ Z,37 SAY '# OF SACKS'
Z = Z + 2
endif
****************
*FIND "5" SACKS*
****************
do while (zip_code >= '00001' .and. zip_code <= '99999-9999')
mzip = left(zip_code,5)
mst = state
count while zip_code = mzip to mcount
sele 1
appe blank
replace zip_code with mzip, count with mcount, state with mst
if mcount >= 125
replace done with .t.
if mcount > mmax
mtest1 = int(mcount/mmax)
mtest2 = int(mcount/mtest1)
if mtest2 > mmax
mnum = mtest1 + 1
else
mnum = mtest1
endif
else
mnum = 1
endif
replace sack with mnum
sele 2
appe blank
replace order with y
replace &mfield with 'Use ' + str(mnum,2) + ' sack(s)'
y = y + 1
appe blank
replace order with y
replace &mfield with 'Use "D" tag'
y = y + 1
find &mzip
replace order with y while zip_code = mzip
sele 1
y = y + 1
@ Z,7 SAY MZIP
@ Z,19 SAY MST
@ Z,28 SAY STR(MCOUNT,4)
@ Z,42 SAY STR(MNUM,2)
z = z + 2
nosack = nosack + mnum
acount = acount + mcount
else
replace done with .f.
endif
sele 2
enddo
****************
*FIND "3" SACKS*
****************
sele 1
do while .t.
set filt to (.not. done .and. count >= 10)
go top
do while .not. eof()
mzip = left(zip_code,3)
mst = state
sum count while zip_code = mzip to mcount
if mcount >= 125
set filt to (.not. done .and. zip_code = mzip)
go top
sum count to mcount
if mcount > mmax
mtest1 = int(mcount/mmax)
mtest2 = int(mcount/mtest1)
if mtest2 > mmax
mnum = mtest1 + 1
else
mnum = mtest1
endif
else
mnum = 1
endif
else
set filt to (.not. done .and. zip_code = mzip)
go top
replace sack with 99, done with .t. while zip_code = mzip
set filt to (.not. done .and. count >= 10)
go top
loop
endif
sele 2
appe blank
replace order with y
replace &mfield with 'Use ' + str(mnum,2) + ' sack(s)'
y = y + 1
appe blank
replace order with y
replace &mfield with 'Use "D" tag'
y = y + 1
sele 1
set filt to (.not. done .and. zip_code = mzip .and. count >= 10)
go top
mzip5 = zip_code
sele 2
find &mzip5
replace order with y while zip_code = mzip5
y = y + 1
sele 1
replace sack with mnum, done with .t.
set filt to (.not. done .and. zip_code = mzip .and. count >= 10)
go top
do while .not. eof()
sele 2
appe blank
replace order with y
replace &mfield with 'Use "D" tag'
y = y + 1
sele 1
mzip5 = zip_code
sele 2
find &mzip5
replace order with y while zip_code = mzip5
y = y + 1
sele 1
replace sack with mnum, done with .t.
skip
enddo
set filt to (.not. done .and. zip_code = mzip)
go top
sele 2
appe blank
replace order with y
replace &mfield with 'Use "3" tag'
y = y + 1
sele 1
mzip5 = zip_code
sele 2
find &mzip5
replace order with y while zip_code = mzip5
y = y + 1
sele 1
replace sack with mnum, done with .t.
do while .not. eof()
mzip5 = zip_code
sele 2
find &mzip5
replace order with y while zip_code = mzip5
y = y + 1
sele 1
replace sack with mnum, done with .t.
skip
enddo
@ Z,7 SAY MZIP
@ Z,19 SAY MST
@ Z,28 SAY STR(MCOUNT,4)
@ Z,42 SAY STR(MNUM,2)
z = z + 2
nosack = nosack + mnum
acount = acount + mcount
set filt to (.not. done .and. count >= 10)
go top
enddo
sele 1
set filt to sack = 99
replace all done with .f., sack with 0
******************
*FIND STATE SACKS*
******************
set filt to .not. done
go top
do while .not. eof()
mst = state
sum count while state = mst to mcount
if mcount >= 125
if mcount > mmax
mtest1 = int(mcount/mmax)
mtest2 = int(mcount/mtest1)
if mtest2 > mmax
mnum = mtest1 + 1
else
mnum = mtest1
endif
else
mnum = 1
endif
@ Z,7 SAY Mst
@ Z,28 SAY STR(MCOUNT,4)
@ Z,42 SAY STR(MNUM,2)
z = z + 2
bcount = bcount + mcount
nosack = nosack + mnum
sele 2
appe blank
replace order with y
replace &mfield with 'BEGIN STATE SACK HERE'
y = y + 1
appe blank
replace &mfield with 'Use ' + str(mnum,2) + ' sack(s)'
replace order with y
y = y + 1
else
sum count to xcount
if mcount <> xcount
go top
replace sack with 88, done with .t. while state = mst
loop
else
mnum = 1
@ Z,7 SAY Mst
@ Z,28 SAY STR(MCOUNT,4)
@ Z,42 SAY STR(MNUM,2)
z = z + 2
bcount = bcount + mcount
nosack = nosack + mnum
sele 2
appe blank
replace order with y
replace &mfield with 'BEGIN STATE SACK HERE'
y = y + 1
appe blank
replace &mfield with 'Use ' + str(mnum,2) + ' sack(s)'
replace order with y
y = y + 1
endif
endif
******************
*FIND "D" BUNDLES*
******************
sele 1
set filt to (.not. done .and. state = mst .and. count >= 10)
go top
if .not. eof()
do while .not. eof()
mzip = zip_code
replace done with .t., sack with mnum
sele 2
appe blank
replace order with y
replace &mfield with 'Use "D" tag'
y = y + 1
find &mzip
replace order with y while zip_code = mzip
y = y + 1
sele 1
go top
do while .not. eof()
mzip = zip_code
replace done with .t., sack with mnum
sele 2
appe blank
replace order with y
replace &mfield with 'Use "D" tag'
y = y + 1
find &mzip
replace order with y while zip_code = mzip
y = y + 1
sele 1
go top
enddo
enddo
endif
******************
*FIND "3" BUNDLES*
******************
set filt to (.not. done .and. state = mst)
go top
if .not. eof()
do while .not. eof()
mzip = left(zip_code,3)
sum count while zip_code = mzip to mcount
if mcount >= 10
sele 2
appe blank
replace order with y
replace &mfield with 'Use "3" tag'
y = y + 1
sele 1
set filt to (.not. done .and. zip_code = mzip .and. sack < 99)
go top
mzip5 = zip_code
replace done with .t., sack with mnum
sele 2
find &mzip5
replace order with y while zip_code = mzip5
y = y + 1
sele 1
do while .not. eof()
go top
mzip5 = zip_code
replace done with .t., sack with mnum
sele 2
find &mzip5
replace order with y while zip_code = mzip5
y = y + 1
sele 1
go top
enddo
else
go top
replace sack with 99, done with .t. while zip_code = mzip
go top
endif
set filt to (.not. done .and. state = mst)
go top
enddo
endif
********************
*FIND STATE BUNDLES*
********************
sele 1
set filt to sack = 99
go top
if .not. eof()
replace all done with .f., sack with 0
set filt to (.not. done .and. state = mst)
go top
sele 2
appe blank
replace &mfield with 'Use "S" tag'
replace order with y
y = y + 1
sele 1
go top
do while .not. eof()
mzip = zip_code
replace sack with mnum, done with .t.
sele 2
find &mzip
replace order with y while zip_code = mzip
y = y + 1
sele 1
go top
enddo
endif
enddo
*************************
*FINAL MIXED STATES SACK*
*************************
sele 1
set filt to sack = 88
go top
if eof()
exit
else
sele 1
sum count to mcount
mtest1 = int(mcount/mmax)
mtest2 = int(mcount/mtest1)
if mtest2 > mmax
mnum = mtest1 + 1
else
mnum = mtest1
endif
nosack = nosack + mnum
sele 2
appe blank
replace order with y
replace &mfield with 'BEGIN MIXED STATES SACK HERE'
y = y + 1
appe blank
replace order with y
replace &mfield with 'Use ' + str(mnum,2) + ' sack(s)'
y = y + 1
sele 1
@ z,7 say 'Mixed States'
@ z,28 say str(MCOUNT,4)
@ z,42 say str(mnum,2)
z = z + 2
bcount = bcount + mcount
nosack = nosack + mnum
replace all done with .f., sack with 0
******************
*FIND "D" BUNDLES*
******************
set filt to (.not. done .and. count >= 10)
if eof()
exit
else
do while .not. eof()
mzip = zip_code
replace done with .t., sack with mnum
sele 2
appe blank
replace order with y
replace &mfield with 'Use "D" tag'
y = y + 1
find &mzip
replace order with y while zip_code = mzip
y = y + 1
sele 1
go top
do while .not. eof()
mzip = zip_code
replace done with .t., sack with mnum
sele 2
appe blank
replace order with y
replace &mfield with 'Use "D" tag'
y = y + 1
find &mzip
replace order with y while zip_code = mzip
y = y + 1
sele 1
go top
enddo
enddo
endif
******************
*FIND "3" BUNDLES*
******************
if eof()
exit
else
do while .not. eof()
mzip = left(zip_code,3)
sum count while zip_code = mzip to mcount
if mcount >= 10
set filt to (.not. done .and. zip_code = mzip .and. sack < 99)
go top
mzip5 = zip_code
replace done with .t., sack with mnum
sele 2
appe blank
replace order with y
replace &mfield with 'Use "3" tag'
y = y + 1
find &mzip5
replace order with y while zip_code = mzip5
y = y + 1
sele 1
do while .not. eof()
go top
mzip5 = zip_code
replace done with .t., sack with mnum
sele 2
find &mzip5
replace order with y while zip_code = mzip5
y = y + 1
sele 1
go top
enddo
else
go top
replace sack with 99, done with .t. while zip_code = mzip
go top
endif
set filt to .not. done
go top
enddo
endif
******************
*FIND "S" BUNDLES*
******************
sele 1
set filt to sack = 99
go top
if eof()
exit
else
replace all done with .f., sack with 0
set filt to .not. done
go top
mst = state
sum count while state = mst to mcount
if mcount >= 10
set filt to (.not. done .and. state = mst)
go top
mzip = zip_code
replace done with .t., sack with mnum
sele 2
appe blank
replace &mfield with 'Use "S" tag'
replace order with y
y = y + 1
find &mzip
replace order with y while zip_code = mzip
y = y + 1
sele 1
do while .not. eof()
go top
mzip = zip_code
replace sack with mnum, done with .t.
sele 2
find &mzip
replace order with y while zip_code = mzip
y = y + 1
sele 1
go top
enddo
else
go top
replace sack with 99, done with .t. while state = mst
go top
endif
set filt to .not. done
endif
***************************
*FIND MIXED STATES BUNDLES*
***************************
sele 1
set filt to sack = 99
go top
if eof()
exit
else
replace all done with .f., sack with 0
set filt to .not. done
sele 2
appe blank
replace &mfield with 'Use "MS" tag'
replace order with y
y = y + 1
sele 1
go top
do while .not. eof()
mzip = zip_code
replace sack with mnum, done with .t.
sele 2
find &mzip
replace order with y while zip_code = mzip
y = y + 1
sele 1
go top
enddo
endif
endif
enddo
*enddo
sele 1
set filt to
z = z + 3
@ z,25 say 'COUNT'
@ z,39 say 'POSTAGE'
@ z,55 say 'TOTAL'
z = z + 2
@ z,5 say '3/5 presort rate: '
@ z,25 say str(acount,5)
@ z,30 say mfive
@ z,50 say acount*mfive pict "#,###,###.##"
z = z + 2
@ z,5 say 'Basic rate: '
@ z,25 say str(bcount,5)
@ z,30 say mbasic
@ z,50 say bcount*mbasic pict "#,###,###.##"
z = z + 3
@ z,5 say 'TOTAL'
@ z,25 say str(acount+bcount,5)
@ z,50 say (acount*mfive)+(bcount*mbasic) pict "#,###,###.##"
z = z + 2
@ z,5 say 'Total sacks in mailing: ' + str(nosack,3)
eject
sele 2
sort to &mlist on order
zap
set device to screen
CLEAR ALL
SET TALK on
SET BELL on
SET HEADING on
SET DELETED off
SET SAFETY on
